perm filename XLIST.F4[CMS,LCS] blob
sn#080728 filedate 1974-01-09 generic text, type T, neo UTF8
00100 DIMENSION JA(8,200),JB(4,200),JC(4,200),JD(5,200)
00200 8 K=0
00300 1 TYPE 6
00400 6 FORMAT(' NEW FILE OR OLD?'/)
00500 ACCEPT 10,M
00600 TYPE 22
00700 22 FORMAT(' TYPE FILE NAME.'/)
00800 ACCEPT 23,F
00900 23 FORMAT(A4)
01000 IF(M.EQ.'O')GO TO 43
01100 10 FORMAT(A1)
01200 15 TYPE 7
01300 7 FORMAT(' TYPE;<LINE 1>:NAME;<LINES 2AND3>:ADDRESS<;AND'/
01400 1 ' <LINE 4>:UP TO 5 ONE LETTER,EXCEPT''Z'',LIST NAMES.'/)
01500 2 K=K+1
01600 TYPE 3
01700 3 FORMAT(' IF FINISHED TYPE <CR>.'/)
01800 ACCEPT 9,(JA(I,K),I=1,8)
01900 9 FORMAT(5A1,3A5)
02000 IF(JA(1,K).EQ.' ')GO TO 33
02100 ACCEPT 11,(JB(I,K),I=1,4)
02200 11 FORMAT(4A5)
02300 ACCEPT 11,(JC(I,K),I=1,4)
02400 ACCEPT 20,(JD(I,K),I=1,5)
02500 20 FORMAT(5A1)
02600 GO TO 2
02700 43 REWIND 1
02800 CALL IFILE(1,F)
02900 READ(1)JB
03000 READ(1)JA
03100 READ(1)JC,K
03200 TYPE 66
03300 66 FORMAT(' PRINTOUT OR ADD NAMES?'/)
03400 ACCEPT 67,P
03500 67 FORMAT(A1)
03600 IF(P.EQ.'P')GO TO 60
03700 GO TO 15
03800 33 K=K-1
03900 REWIND 1
04000 CALL OFILE(1,F)
04100 WRITE(1)JB,K
04200 WRITE(1)JA,K
04300 WRITE(1)JC,K,K
04400 60 TYPE 77
04500 77 FORMAT(' TYPE LIST NAME OR Z FOR ALL LISTS.'/)
04600 ACCEPT 78,X
04700 78 FORMAT(A1)
04800 Y=' '
04900 IF(X.EQ.'Z')GO TO 53
05000 N=0
05100 DO 99 L=1,K
05200 DO 97 I=1,5
05300 IF(JD(I,L).EQ.X)GO TO 98
05400 97 CONTINUE
05500 GO TO 99
05600 98 N=N+1
05700 DO 51 M=1,8
05800 51 JA(M,N)=JA(M,L)
05900 DO 102 M=1,4
06000 JB(M,N)=JB(M,L)
06100 102 JC(M,N)=JC(M,L)
06200 DO 100 M=1,5
06300 100 JD(M,N)=JD(M,L)
06400 WRITE(5,91)(JA(I,N),I=1,8)
06500 91 FORMAT(/4X5A1,3A5)
06600 99 CONTINUE
06700 K=N
06800 53 Y='Y'
06900 TYPE 13
07000 13 FORMAT(' TTY OR LINE PRINTER?'/)
07100 ACCEPT 17,T
07200 17 FORMAT(A1)
07300 IF(T.NE.'L')GO TO 103
07400 TYPE 88
07500 88 FORMAT(' PRINT WITH LIST NAMES?'/)
07600 ACCEPT 90,Y
07700 90 FORMAT(A1)
07800 103 LIST=5
07900 IF(T.EQ.'L')LIST=3
08000 DO 45 J=1,K,3
08100 WRITE(LIST,19)((JA(I,L),I=1,8),L=J,J+2)
08200 19 FORMAT(//3(4X5A1,3A5))
08300 WRITE(LIST,46)((JB(I,L),I=1,4),L=J,J+2)
08400 46 FORMAT(3(4X4A5))
08500 WRITE(LIST,46)((JC(I,L),I=1,4),L=J,J+2)
08600 IF(Y.NE.'Y')GO TO 45
08700 WRITE(LIST,48)((JD(I,L),I=1,5),L=J,J+2)
08800 48 FORMAT(/3(19X5A1))
08900 45 CONTINUE
09000 IF(T.EQ.'L')CALL EXIT
09100 GO TO 8
09200 END